home *** CD-ROM | disk | FTP | other *** search
/ PC World 2007 March / PCWorld_2007-03_cd.bin / domacnost a kancelar / scribus / scribus-1.3.3.7-win32-install.exe / tcl / tix8.1 / NoteBook.tcl < prev    next >
Text File  |  2002-01-24  |  6KB  |  250 lines
  1. # -*- mode: TCL; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -*-
  2. #
  3. #    $Id: NoteBook.tcl,v 1.3.2.3 2002/01/24 10:08:58 idiscovery Exp $
  4. #
  5. # NoteBook.tcl --
  6. #
  7. #    tixNoteBook: NoteBook type of window.
  8. #
  9. # Copyright (c) 1993-1999 Ioi Kim Lam.
  10. # Copyright (c) 2000-2001 Tix Project Group.
  11. #
  12. # See the file "license.terms" for information on usage and redistribution
  13. # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  14. #
  15.  
  16. tixWidgetClass tixNoteBook {
  17.     -classname TixNoteBook
  18.     -superclass tixVStack
  19.     -method {
  20.     }
  21.     -flag {
  22.     }
  23.     -configspec {
  24.     {-takefocus takeFocus TakeFocus 0 tixVerifyBoolean} 
  25.     }
  26.     -default {
  27.     {.nbframe.tabPadX    8}
  28.     {.nbframe.tabPadY    5}
  29.     {.nbframe.borderWidth    2}
  30.     {*nbframe.relief    raised}
  31.     }
  32. }
  33.  
  34. proc tixNoteBook:InitWidgetRec {w} {
  35.     upvar #0 $w data
  36.  
  37.     tixChainMethod $w InitWidgetRec
  38.  
  39.     set data(pad-x1) 0
  40.     set data(pad-x2) 0
  41.     set data(pad-y1) 20
  42.     set data(pad-y2) 0
  43. }
  44.  
  45. proc tixNoteBook:ConstructWidget {w} {
  46.     upvar #0 $w data
  47.  
  48.     tixChainMethod $w ConstructWidget
  49.     
  50.     set data(w:top) [tixNoteBookFrame $w.nbframe -slave 1 -takefocus 1]
  51.     set data(w:nbframe) $data(w:top)
  52.  
  53.     bind $data(w:top) <ButtonPress-1> "tixNoteBook:MouseDown $w %x %y"
  54.     bind $data(w:top) <ButtonRelease-1> "tixNoteBook:MouseUp $w %x %y"
  55.  
  56.     bind $data(w:top) <B1-Motion> "tixNoteBook:MouseDown $w %x %y"
  57.  
  58.     bind $data(w:top) <Left>  "tixNoteBook:FocusNext $w prev"
  59.     bind $data(w:top) <Right> "tixNoteBook:FocusNext $w next"
  60.  
  61.     bind $data(w:top) <Return> "tixNoteBook:SetFocusByKey $w"
  62.     bind $data(w:top) <space>  "tixNoteBook:SetFocusByKey $w"
  63. }
  64.  
  65. #----------------------------------------------------------------------
  66. # Public methods
  67. #----------------------------------------------------------------------
  68. proc tixNoteBook:add {w child args} {
  69.     upvar #0 $w data
  70.  
  71.     set ret [eval tixChainMethod $w add $child $args]
  72.  
  73.     set new_args ""
  74.     tixForEach {flag value} $args {
  75.     if {$flag != "-createcmd" && $flag != "-raisecmd"} {
  76.         lappend new_args $flag
  77.         lappend new_args $value
  78.     }
  79.     }
  80.  
  81.     eval $data(w:top) add $child $new_args
  82.  
  83.     return $ret
  84. }
  85.  
  86. proc tixNoteBook:raise {w child} {
  87.     upvar #0 $w data
  88.  
  89.     tixChainMethod $w raise $child
  90.  
  91.     if {[$data(w:top) pagecget $child -state] == "normal"} {
  92.     $data(w:top) activate $child
  93.     }
  94. }
  95.  
  96. proc tixNoteBook:delete {w child} {
  97.     upvar #0 $w data
  98.  
  99.     tixChainMethod $w delete $child
  100.     $data(w:top) delete $child
  101. }
  102.  
  103. #----------------------------------------------------------------------
  104. # Private methods
  105. #----------------------------------------------------------------------
  106. proc tixNoteBook:Resize {w} {
  107.     upvar #0 $w data
  108.  
  109.     # We have to take care of the size of the tabs so that 
  110.     #
  111.     set rootReq [$data(w:top) geometryinfo]
  112.     set tW [lindex $rootReq 0]
  113.     set tH [lindex $rootReq 1]
  114.  
  115.     set data(pad-x1) 2 
  116.     set data(pad-x2) 2
  117.     set data(pad-y1) [expr $tH + $data(-ipadx) + 1]
  118.     set data(pad-y2) 2
  119.     set data(minW)   [expr $tW]
  120.     set data(minH)   [expr $tH]
  121.  
  122.     # Now that we know data(pad-y1), we can chain the call
  123.     #
  124.     tixChainMethod $w Resize
  125. }
  126.  
  127. proc tixNoteBook:MouseDown {w x y} {
  128.     upvar #0 $w data
  129.  
  130.     focus $data(w:top)
  131.  
  132.     set name [$data(w:top) identify $x $y]
  133.     $data(w:top) focus $name
  134.     set data(w:down) $name
  135. }
  136.  
  137. proc tixNoteBook:MouseUp {w x y} {
  138.     upvar #0 $w data
  139.  
  140.     #it could happen (using the tk/menu) that a MouseUp
  141.     #proceeds without a MouseDown event!!
  142.     if {! [info exists data(w:down)] || ! [info exists data(w:top)]} {
  143.     return
  144.     }
  145.     
  146.     set name [$data(w:top) identify $x $y]
  147.  
  148.     if {$name != "" && $name == $data(w:down) && [$data(w:top) pagecget $name -state] == "normal" } {
  149.         $data(w:top) activate $name
  150.         tixCallMethod $w raise $name
  151.     } else {
  152.         $data(w:top) focus ""
  153.     }
  154. }
  155.  
  156.  
  157. #----------------------------------------------------------------------
  158. #
  159. # Section for keyboard bindings
  160. #
  161. #----------------------------------------------------------------------
  162.  
  163. proc tixNoteBook:FocusNext {w dir} {
  164.     upvar #0 $w data
  165.  
  166.     if {[$data(w:top) info focus] == ""} {
  167.     set name [$data(w:top) info active]
  168.     $data(w:top) focus $name
  169.  
  170.     if {$name != ""} {
  171.         return
  172.     }
  173.     } else {
  174.     set name [$data(w:top) info focus$dir]
  175.      $data(w:top) focus $name
  176.    }
  177. }
  178.  
  179. proc tixNoteBook:SetFocusByKey {w} {
  180.     upvar #0 $w data
  181.  
  182.     set name [$data(w:top) info focus]
  183.  
  184.     if {$name != "" && [$data(w:top) pagecget $name -state] == "normal"} {
  185.     tixCallMethod $w raise $name
  186.     $data(w:top) activate $name
  187.     }
  188. }
  189.  
  190. #----------------------------------------------------------------------
  191. # Automatic bindings for alt keys
  192. #----------------------------------------------------------------------
  193. proc tixNoteBookFind {w char} {
  194.     set char [string tolower $char]
  195.  
  196.     foreach child [winfo child $w] {
  197.     if {![winfo ismapped $w]} {
  198.         continue
  199.     }
  200.     switch [winfo class $child] {
  201.         {Toplevel} {
  202.         continue
  203.         }
  204.         TixNoteBook {
  205.         set nbframe [$child subwidget nbframe]
  206.         foreach page [$nbframe info pages] {
  207.             set char2 [string index [$nbframe pagecget $page -label] \
  208.             [$nbframe pagecget $page -underline]]
  209.             if {([string compare $char [string tolower $char2]] == 0)||
  210.             ($char == "")} {
  211.             if {[$nbframe pagecget $page -state] != "disabled"} {
  212.                 return [list $child $page]
  213.             }
  214.             }
  215.         }
  216.         }
  217.     }
  218.     # Well, this notebook doesn't match with the key, but maybe
  219.     # it contains a "subnotebook" that will match ..
  220.     set match [tixNoteBookFind $child $char]
  221.     if {$match != ""} {
  222.         return $match
  223.     }
  224.     }
  225.     return ""
  226. }
  227.  
  228. proc tixTraverseToNoteBook {w char} {
  229.     if {$char == ""} {
  230.     return 0
  231.     }
  232.     if {![winfo exists $w]} {
  233.     return 0
  234.     }
  235.     set list [tixNoteBookFind [winfo toplevel $w] $char]
  236.     if {$list != ""} {
  237.     [lindex $list 0] raise [lindex $list 1]
  238.     return 1
  239.     }
  240.     return 0
  241. }
  242.  
  243. #----------------------------------------------------------------------
  244. # Set default class bindings
  245. #----------------------------------------------------------------------
  246.  
  247. bind all <Alt-KeyPress> "+tixTraverseToNoteBook %W %A"
  248. bind all <Meta-KeyPress> "+tixTraverseToNoteBook %W %A"
  249.  
  250.